home *** CD-ROM | disk | FTP | other *** search
/ Inter.Net 55-1 / Inter.Net 55-1.iso / CBuilder / Setup / BCB / data.z / dbtables.int < prev    next >
Encoding:
Text File  |  1998-02-09  |  31.4 KB  |  859 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Delphi Visual Component Library                 }
  5. {       BDE Data Access                                 }
  6. {                                                       }
  7. {       Copyright (c) 1995,98 Borland International     }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. unit DBTables;
  12.  
  13. {$R-}
  14.  
  15. interface
  16.  
  17. uses Windows, SysUtils, Graphics, Classes, Controls, Db, DBCommon, Bde, SMIntf,
  18.   StdVCL;
  19.  
  20. const
  21.  
  22. { SQL Trace buffer size }
  23.  
  24.   smTraceBufSize = 32767 + SizeOf(TraceDesc);
  25.  
  26. { TDBDataSet flags }
  27.  
  28.   dbfOpened     = 0;
  29.   dbfPrepared   = 1;
  30.   dbfExecSQL    = 2;
  31.   dbfTable      = 3;
  32.   dbfFieldList  = 4;
  33.   dbfIndexList  = 5;
  34.   dbfStoredProc = 6;
  35.   dbfExecProc   = 7;
  36.   dbfProcDesc   = 8;
  37.   dbfDatabase   = 9;
  38.  
  39. type
  40.  
  41. { Forward declarations }
  42.  
  43.   TDBError = class;
  44.   TSession = class;
  45.   TDatabase = class;
  46.   TBDEDataSet = class;
  47.   TDBDataSet = class;
  48.   TTable = class;
  49.  
  50. { Generic types }
  51.  
  52.   PFieldDescList = ^TFieldDescList;
  53.   TFieldDescList = array[0..1023] of FLDDesc;
  54.  
  55.   PIndexDescList = ^TIndexDescList;
  56.   TIndexDescList = array[0..63] of IDXDesc;
  57.  
  58.   PSPParamDescList = ^TSPParamDescList;
  59.   TSPParamDescList = array[0..1023] of SPParamDesc;
  60.  
  61. { Exception classes }
  62.  
  63.   EDBEngineError = class(EDatabaseError)
  64.   public
  65.     constructor Create(ErrorCode: DBIResult);
  66.     destructor Destroy; override;
  67.     property ErrorCount: Integer;
  68.     property Errors[Index: Integer]: TDBError;
  69.   end;
  70.  
  71.   ENoResultSet = class(EDatabaseError);
  72.  
  73. { BDE error information type }
  74.  
  75.   TDBError = class
  76.   public
  77.     constructor Create(Owner: EDBEngineError; ErrorCode: DBIResult;
  78.       NativeError: Longint; Message: PChar);
  79.     property Category: Byte;
  80.     property ErrorCode: DBIResult;
  81.     property SubCode: Byte;
  82.     property Message: string;
  83.     property NativeError: Longint;
  84.   end;
  85.  
  86. { TLocale }
  87.  
  88.   TLocale = Pointer;
  89.  
  90. { TBDECallback }
  91.  
  92.   TBDECallbackEvent = function(CBInfo: Pointer): CBRType of Object;
  93.  
  94.   TBDECallback = class
  95.   protected
  96.     function Invoke(CallType: CBType; CBInfo: Pointer): CBRType;
  97.   public
  98.     constructor Create(AOwner: TObject; Handle: hDBICur; CBType: CBType;
  99.       CBBuf: Pointer; CBBufSize: Integer; CallbackEvent: TBDECallbackEvent;
  100.       Chain: Boolean);
  101.     destructor Destroy; override;
  102.   end;
  103.  
  104. { TSessionList }
  105.  
  106.   TSessionList = class(TObject)
  107.   public
  108.     constructor Create;
  109.     destructor Destroy; override;
  110.     property CurrentSession: TSession;
  111.     function FindSession(const SessionName: string): TSession;
  112.     procedure GetSessionNames(List: TStrings);
  113.     function OpenSession(const SessionName: string): TSession;
  114.     property Count: Integer;
  115.     property Sessions[Index: Integer]: TSession; default;
  116.     property List[const SessionName: string]: TSession;
  117.   end;
  118.  
  119. { TSession }
  120.  
  121.   TConfigModes = (cfmVirtual, cfmPersistent, cfmSession);
  122.   TConfigMode = set of TConfigModes;
  123.  
  124.   TPasswordEvent = procedure(Sender: TObject; var Continue: Boolean) of Object;
  125.  
  126.   TDatabaseEvent = (dbOpen, dbClose, dbAdd, dbRemove, dbAddAlias, dbDeleteAlias,
  127.     dbAddDriver, dbDeleteDriver);
  128.  
  129.   TDatabaseNotifyEvent = procedure(DBEvent: TDatabaseEvent; const Param) of object;
  130.  
  131.   TBDEInitProc = procedure(Session: TSession);
  132.  
  133.   TTraceFlag = (tfQPrepare, tfQExecute, tfError, tfStmt, tfConnect,
  134.     tfTransact, tfBlob, tfMisc, tfVendor, tfDataIn, tfDataOut);
  135.  
  136.   TTraceFlags = set of TTraceFlag;
  137.  
  138.   TSession = class(TComponent)
  139.   protected
  140.     procedure Loaded; override;
  141.     procedure ModifyConfigParams(const Path, Node: string; List: TStrings);
  142.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  143.     property OnDBNotify: TDatabaseNotifyEvent;
  144.     property BDEOwnsLoginCbDb: Boolean;
  145.     procedure SetName(const NewName: TComponentName); override;
  146.   public
  147.     constructor Create(AOwner: TComponent); override;
  148.     destructor Destroy; override;
  149.     procedure AddAlias(const Name, Driver: string; List: TStrings);
  150.     procedure AddDriver(const Name: string; List: TStrings);
  151.     procedure AddStandardAlias(const Name, Path, DefaultDriver: string);
  152.     property ConfigMode: TConfigMode;
  153.     procedure AddPassword(const Password: string);
  154.     procedure Close;
  155.     procedure CloseDatabase(Database: TDatabase);
  156.     procedure DeleteAlias(const Name: string);
  157.     procedure DeleteDriver(const Name: string);
  158.     procedure DropConnections;
  159.     function FindDatabase(const DatabaseName: string): TDatabase;
  160.     procedure GetAliasNames(List: TStrings);
  161.     procedure GetAliasParams(const AliasName: string; List: TStrings);
  162.     function GetAliasDriverName(const AliasName: string): string;
  163.     procedure GetConfigParams(const Path, Section: string; List: TStrings);
  164.     procedure GetDatabaseNames(List: TStrings);
  165.     procedure GetDriverNames(List: TStrings);
  166.     procedure GetDriverParams(const DriverName: string; List: TStrings);
  167.     function GetPassword: Boolean;
  168.     procedure GetTableNames(const DatabaseName, Pattern: string;
  169.       Extensions, SystemTables: Boolean; List: TStrings);
  170.     procedure GetStoredProcNames(const DatabaseName: string; List: TStrings);
  171.     function IsAlias(const Name: string): Boolean;
  172.     procedure ModifyAlias(Name: string; List: TStrings);
  173.     procedure ModifyDriver(Name: string; List: TStrings);
  174.     procedure Open;
  175.     function OpenDatabase(const DatabaseName: string): TDatabase;
  176.     procedure RemoveAllPasswords;
  177.     procedure RemovePassword(const Password: string);
  178.     procedure SaveConfigFile;
  179.     property DatabaseCount: Integer;
  180.     property Databases[Index: Integer]: TDatabase;
  181.     property Handle: HDBISES;
  182.     property Locale: TLocale;
  183.     property TraceFlags: TTraceFlags;
  184.   published
  185.     property Active: Boolean default False;
  186.     property AutoSessionName: Boolean default False;
  187.     property KeepConnections: Boolean default True;
  188.     property NetFileDir: string;
  189.     property PrivateDir: string;
  190.     property SessionName: string;
  191.     property SQLHourGlass: Boolean default True;
  192.     property OnPassword: TPasswordEvent;
  193.     property OnStartup: TNotifyEvent;
  194.   end;
  195.  
  196. { TParamList }
  197.  
  198.   TParamList = class(TObject)
  199.   public
  200.     constructor Create(Params: TStrings);
  201.     destructor Destroy; override;
  202.     property Buffer: PChar;
  203.     property FieldCount: Integer;
  204.     property FieldDescs: PFieldDescList;
  205.   end;
  206.  
  207. { TDatabase }
  208.  
  209.   TTransIsolation = (tiDirtyRead, tiReadCommitted, tiRepeatableRead);
  210.  
  211.   TLoginEvent = procedure(Database: TDatabase;
  212.     LoginParams: TStrings) of object;
  213.  
  214.   TDatabase = class(TComponent)
  215.   protected
  216.     procedure Loaded; override;
  217.     procedure Notification(AComponent: TComponent; Operation: TOperation); override;
  218.   public
  219.     constructor Create(AOwner: TComponent); override;
  220.     destructor Destroy; override;
  221.     procedure ApplyUpdates(const DataSets: array of TDBDataSet);
  222.     procedure Close;
  223.     procedure CloseDataSets;
  224.     procedure Commit;
  225.     procedure FlushSchemaCache(const TableName: string);
  226.     procedure Open;
  227.     procedure Rollback;
  228.     procedure StartTransaction;
  229.     procedure ValidateName(const Name: string);
  230.     property DataSetCount: Integer;
  231.     property DataSets[Index: Integer]: TDBDataSet;
  232.     property Directory: string;
  233.     property Handle: HDBIDB;
  234.     property IsSQLBased: Boolean;
  235.     property InTransaction: Boolean;
  236.     property Locale: TLocale;
  237.     property Session: TSession;
  238.     property Temporary: Boolean;
  239.     property SessionAlias: Boolean;
  240.     property TraceFlags: TTraceFlags;
  241.   published
  242.     property AliasName: string;
  243.     property Connected: Boolean default False;
  244.     property DatabaseName: string;
  245.     property DriverName: string;
  246.     property HandleShared: Boolean default False;
  247.     property KeepConnection: Boolean default True;
  248.     property LoginPrompt: Boolean default True;
  249.     property Params: TStrings;
  250.     property SessionName: string;
  251.     property TransIsolation: TTransIsolation default tiReadCommitted;
  252.     property OnLogin: TLoginEvent;
  253.   end;
  254.  
  255. { TBDEDataSet }
  256.  
  257.   TRecNoStatus = (rnDbase, rnParadox, rnNotSupported);
  258.   TUpdateAction = (uaFail, uaAbort, uaSkip, uaRetry, uaApplied);
  259.   TUpdateRecordTypes = set of (rtModified, rtInserted, rtDeleted, rtUnmodified);
  260.   TUpdateErrorEvent = procedure(DataSet: TDataSet; E: EDatabaseError;
  261.     UpdateKind: TUpdateKind; var UpdateAction: TUpdateAction) of object;
  262.   TUpdateRecordEvent = procedure(DataSet: TDataSet; UpdateKind: TUpdateKind;
  263.     var UpdateAction: TUpdateAction) of object;
  264.   TOnServerYieldEvent = procedure(DataSet: TDataSet; var AbortQuery: Boolean) of object;
  265.   TDataSetUpdateObject = class(TComponent)
  266.   protected
  267.     function GetDataSet: TBDEDataSet; virtual; abstract;
  268.     procedure SetDataSet(ADataSet: TBDEDataSet); virtual; abstract;
  269.     procedure Apply(UpdateKind: TUpdateKind); virtual; abstract;
  270.     property DataSet: TBDEDataSet;
  271.   end;
  272.  
  273.   TKeyIndex = (kiLookup, kiRangeStart, kiRangeEnd, kiCurRangeStart,
  274.     kiCurRangeEnd, kiSave);
  275.  
  276.   PKeyBuffer = ^TKeyBuffer;
  277.   TKeyBuffer = record
  278.     Modified: Boolean;
  279.     Exclusive: Boolean;
  280.     FieldCount: Integer;
  281.     Data: record end;
  282.   end;
  283.  
  284.   PRecInfo = ^TRecInfo;
  285.   TRecInfo = record
  286.     RecordNumber: Longint;
  287.     UpdateStatus: TUpdateStatus;
  288.     BookmarkFlag: TBookmarkFlag;
  289.   end;
  290.  
  291.   TBlobData = string;
  292.   TBlobDataArray = array[0..0] of TBlobData;
  293.   PBlobDataArray = ^TBlobDataArray;
  294.  
  295.   TBDEDataSet = class(TDataSet)
  296.   protected
  297.     procedure ActivateFilters;
  298.     procedure AddFieldDesc(FieldDesc: FLDDesc; ARequired: Boolean);
  299.     procedure AllocCachedUpdateBuffers(Allocate: Boolean);
  300.     procedure AllocKeyBuffers;
  301.     function AllocRecordBuffer: PChar; override;
  302.     function BCDToCurr(BCD: Pointer; var Curr: Currency): Boolean; override;
  303.     function CurrToBCD(const Curr: Currency; BCD: Pointer; Precision,
  304.       Decimals: Integer): Boolean; override;
  305.     function CachedUpdateCallBack(CBInfo: Pointer): CBRType;
  306.     procedure CheckCachedUpdateMode;
  307.     procedure CheckSetKeyMode;
  308.     procedure ClearCalcFields(Buffer: PChar); override;
  309.     procedure CloseCursor; override;
  310.     procedure CloseBlob(Field: TField); override;
  311.     function CreateExprFilter(const Expr: string;
  312.       Options: TFilterOptions; Priority: Integer): HDBIFilter;
  313.     function CreateFuncFilter(FilterFunc: Pointer;
  314.       Priority: Integer): HDBIFilter;
  315.     function CreateHandle: HDBICur; virtual;
  316.     function CreateLookupFilter(Fields: TList; const Values: Variant;
  317.       Options: TLocateOptions; Priority: Integer): HDBIFilter;
  318.     procedure DeactivateFilters;
  319.     procedure DestroyHandle; virtual;
  320.     procedure DestroyLookupCursor; virtual;
  321.     function FindRecord(Restart, GoForward: Boolean): Boolean; override;
  322.     function ForceUpdateCallback: Boolean;
  323.     procedure FreeKeyBuffers;
  324.     procedure FreeRecordBuffer(var Buffer: PChar); override;
  325.     procedure GetBookmarkData(Buffer: PChar; Data: Pointer); override;
  326.     function GetBookmarkFlag(Buffer: PChar): TBookmarkFlag; override;
  327.     function GetCanModify: Boolean; override;
  328.     function GetFieldData(Field: TField; Buffer: Pointer): Boolean; override;
  329.     function GetIndexField(Index: Integer): TField;
  330.     function GetIndexFieldCount: Integer;
  331.     function GetIsIndexField(Field: TField): Boolean; override;
  332.     function GetKeyBuffer(KeyIndex: TKeyIndex): PKeyBuffer;
  333.     function GetKeyExclusive: Boolean;
  334.     function GetKeyFieldCount: Integer;
  335.     function GetLookupCursor(const KeyFields: string;
  336.       CaseInsensitive: Boolean): HDBICur; virtual;
  337.     function GetRecord(Buffer: PChar; GetMode: TGetMode; DoCheck: Boolean): TGetResult; override;
  338.     function GetRecordCount: Integer; override;
  339.     function GetRecNo: Integer; override;
  340.     function GetRecordSize: Word; override;
  341.     function GetStateFieldValue(State: TDataSetState; Field: TField): Variant; override;
  342.     function GetUpdatesPending: Boolean;
  343.     function GetUpdateRecordSet: TUpdateRecordTypes;
  344.     function InitKeyBuffer(Buffer: PKeyBuffer): PKeyBuffer;
  345.     procedure InitRecord(Buffer: PChar); override;
  346.     procedure InternalAddRecord(Buffer: Pointer; Append: Boolean); override;
  347.     procedure InternalCancel; override;
  348.     procedure InternalClose; override;
  349.     procedure InternalDelete; override;
  350.     procedure InternalEdit; override;
  351.     procedure InternalFirst; override;
  352.     procedure InternalGotoBookmark(Bookmark: TBookmark); override;
  353.     procedure InternalHandleException; override;
  354.     procedure InternalInitFieldDefs; override;
  355.     procedure InternalInitRecord(Buffer: PChar); override;
  356.     procedure InternalLast; override;
  357.     procedure InternalOpen; override;
  358.     procedure InternalPost; override;
  359.     procedure InternalRefresh; override;
  360.     procedure InternalSetToRecord(Buffer: PChar); override;
  361.     function IsCursorOpen: Boolean; override;
  362.     function LocateRecord(const KeyFields: string; const KeyValues: Variant;
  363.       Options: TLocateOptions; SyncCursor: Boolean): Boolean;
  364.     function MapsToIndex(Fields: TList; CaseInsensitive: Boolean): Boolean;
  365.     procedure OpenCursor(InfoQuery: Boolean); override;
  366.     procedure PostKeyBuffer(Commit: Boolean);
  367.     procedure PrepareCursor; virtual;
  368.     function ProcessUpdates(UpdCmd: DBIDelayedUpdCmd): DBIResult;
  369.     function ResetCursorRange: Boolean;
  370.     procedure SetBookmarkData(Buffer: PChar; Data: Pointer); override;
  371.     procedure SetBookmarkFlag(Buffer: PChar; Value: TBookmarkFlag); override;
  372.     procedure SetCachedUpdates(Value: Boolean);
  373.     function SetCursorRange: Boolean;
  374.     procedure SetFieldData(Field: TField; Buffer: Pointer); override;
  375.     procedure SetFilterData(const Text: string; Options: TFilterOptions);
  376.     procedure SetFilterHandle(var Filter: HDBIFilter; Value: HDBIFilter);
  377.     procedure SetFiltered(Value: Boolean); override;
  378.     procedure SetFilterOptions(Value: TFilterOptions); override;
  379.     procedure SetFilterText(const Value: string); override;
  380.     procedure SetIndexField(Index: Integer; Value: TField);
  381.     procedure SetKeyBuffer(KeyIndex: TKeyIndex; Clear: Boolean);
  382.     procedure SetKeyExclusive(Value: Boolean);
  383.     procedure SetKeyFieldCount(Value: Integer);
  384.     procedure SetKeyFields(KeyIndex: TKeyIndex; const Values: array of const);
  385.     procedure SetLinkRanges(MasterFields: TList);
  386.     procedure SetLocale(Value: TLocale);
  387.     procedure SetStateFieldValue(State: TDataSetState; Field: TField; Value: Variant); override;
  388.     procedure SetOnFilterRecord(const Value: TFilterRecordEvent); override;
  389.     procedure SetOnUpdateError(UpdateEvent: TUpdateErrorEvent);
  390.     procedure SetRecNo(Value: Integer); override;
  391.     procedure SetupCallBack(Value: Boolean);
  392.     procedure SetUpdateRecordSet(RecordTypes: TUpdateRecordTypes);
  393.     procedure SetUpdateObject(Value: TDataSetUpdateObject);
  394.     procedure SwitchToIndex(const IndexName, TagName: string);
  395.     function UpdateCallbackRequired: Boolean;
  396.     function YieldCallBack(CBInfo: Pointer): CBRType;
  397.   public
  398.     constructor Create(AOwner: TComponent); override;
  399.     destructor Destroy; override;
  400.     procedure ApplyUpdates;
  401.     function BookmarkValid(Bookmark: TBookmark): Boolean; override;
  402.     procedure Cancel; override;
  403.     procedure CancelUpdates;
  404.     property CacheBlobs: Boolean default True;
  405.     function CompareBookmarks(Bookmark1, Bookmark2: TBookmark): Integer; override;
  406.     procedure CommitUpdates;
  407.     function ConstraintCallBack(Req: DsInfoReq; var ADataSources: DataSources): DBIResult; stdcall;
  408.     function ConstraintsDisabled: Boolean;
  409.     function CreateBlobStream(Field: TField; Mode: TBlobStreamMode): TStream; override;
  410.     procedure DisableConstraints;
  411.     procedure EnableConstraints;
  412.     procedure FetchAll;
  413.     procedure FlushBuffers;
  414.     function GetCurrentRecord(Buffer: PChar): Boolean; override;
  415.     procedure GetIndexInfo;
  416.     function Locate(const KeyFields: string; const KeyValues: Variant;
  417.       Options: TLocateOptions): Boolean; override;
  418.     function Lookup(const KeyFields: string; const KeyValues: Variant;
  419.       const ResultFields: string): Variant; override;
  420.     function IsSequenced: Boolean; override;
  421.     procedure Post; override;
  422.     procedure RevertRecord;
  423.     function UpdateStatus: TUpdateStatus;
  424.     procedure Translate(Src, Dest: PChar; ToOem: Boolean);  override;
  425.  
  426.     property ExpIndex: Boolean;
  427.     property Handle: HDBICur;
  428.     property KeySize: Word;
  429.     property Locale: TLocale;
  430.     property UpdateObject: TDataSetUpdateObject;
  431.     property UpdatesPending: Boolean;
  432.     property UpdateRecordTypes: TUpdateRecordTypes;
  433.   published
  434.     property Active;
  435.     property AutoCalcFields;
  436.     property CachedUpdates: Boolean default False;
  437.     property Filter;
  438.     property Filtered;
  439.     property FilterOptions;
  440.     property BeforeOpen;
  441.     property AfterOpen;
  442.     property BeforeClose;
  443.     property AfterClose;
  444.     property BeforeInsert;
  445.     property AfterInsert;
  446.     property BeforeEdit;
  447.     property AfterEdit;
  448.     property BeforePost;
  449.     property AfterPost;
  450.     property BeforeCancel;
  451.     property AfterCancel;
  452.     property BeforeDelete;
  453.     property AfterDelete;
  454.     property BeforeScroll;
  455.     property AfterScroll;
  456.     property OnCalcFields;
  457.     property OnDeleteError;
  458.     property OnEditError;
  459.     property OnFilterRecord;
  460.     property OnNewRecord;
  461.     property OnPostError;
  462.     property OnServerYield: TOnServerYieldEvent;
  463.     property OnUpdateError: TUpdateErrorEvent;
  464.     property OnUpdateRecord: TUpdateRecordEvent;
  465.   end;
  466.  
  467. { TDBDataSet }
  468.  
  469.   TUpdateMode = (upWhereAll, upWhereChanged, upWhereKeyOnly);
  470.   TDBFlags = set of 0..15;
  471.  
  472.   TDBDataSet = class(TBDEDataSet)
  473.   protected
  474.     procedure CloseCursor; override;
  475.     function ConstraintsStored: Boolean;
  476.     procedure Disconnect; virtual;
  477.     function GetProvider: IProvider; virtual;
  478.     procedure OpenCursor(InfoQuery: Boolean); override;
  479.     function SetDBFlag(Flag: Integer; Value: Boolean): Boolean; virtual;
  480.     property DBFlags: TDBFlags;
  481.     property UpdateMode: TUpdateMode default upWhereAll;
  482.   public
  483.     function CheckOpen(Status: DBIResult): Boolean;
  484.     procedure CloseDatabase(Database: TDatabase);
  485.     function OpenDatabase: TDatabase;
  486.     property Database: TDatabase;
  487.     property DBHandle: HDBIDB;
  488.     property DBLocale: TLocale;
  489.     property DBSession: TSession;
  490.     property Provider: IProvider;
  491.   published
  492.     property DatabaseName: string;
  493.     property SessionName: string;
  494.   end;
  495.  
  496. { TTable }
  497.  
  498.   TBatchMode = (batAppend, batUpdate, batAppendUpdate, batDelete, batCopy);
  499.   TTableType = (ttDefault, ttParadox, ttDBase, ttFoxPro, ttASCII);
  500.   TLockType = (ltReadLock, ltWriteLock);
  501.   TIndexName = type string;
  502.  
  503.   TIndexFiles = class(TStringList)
  504.   public
  505.     constructor Create(AOwner: TTable);
  506.     function Add(const S: string): Integer; override;
  507.     procedure Clear; override;
  508.     procedure Delete(Index: Integer); override;
  509.     procedure Insert(Index: Integer; const S: string); override;
  510.   end;
  511.  
  512.   TTable = class(TDBDataSet)
  513.   protected
  514.     function CreateHandle: HDBICur; override;
  515.     procedure DataEvent(Event: TDataEvent; Info: Longint); override;
  516.     procedure DefChanged(Sender: TObject); override;
  517.     procedure DestroyHandle; override;
  518.     procedure DestroyLookupCursor; override;
  519.     procedure DoOnNewRecord; override;
  520.     procedure EncodeFieldDesc(var FieldDesc: FLDDesc;
  521.       const Name: string; DataType: TFieldType; Size: Word);
  522.     procedure EncodeIndexDesc(var IndexDesc: IDXDesc;
  523.       const Name, FieldExpression: string; Options: TIndexOptions);
  524.     function GetCanModify: Boolean; override;
  525.     function GetDataSource: TDataSource; override;
  526.     function GetHandle(const IndexName, IndexTag: string): HDBICur;
  527.     function GetLanguageDriverName: string;
  528.     function GetLookupCursor(const KeyFields: string;
  529.       CaseInsensitive: Boolean): HDBICur; override;
  530.     procedure InitFieldDefs; override;
  531.     function IsProductionIndex(const IndexName: string): Boolean;
  532.     function GetFileName: string;
  533.     function GetTableType: TTableType;
  534.     procedure PrepareCursor; override;
  535.     procedure UpdateIndexDefs; override;
  536.     property MasterLink: TMasterDataLink;
  537.   public
  538.     constructor Create(AOwner: TComponent); override;
  539.     destructor Destroy; override;
  540.     function BatchMove(ASource: TBDEDataSet; AMode: TBatchMode): Longint;
  541.     procedure AddIndex(const Name, Fields: string; Options: TIndexOptions);
  542.     procedure ApplyRange;
  543.     procedure CancelRange;
  544.     procedure CloseIndexFile(const IndexFileName: string);
  545.     procedure CreateTable;
  546.     procedure DeleteIndex(const Name: string);
  547.     procedure DeleteTable;
  548.     procedure EditKey;
  549.     procedure EditRangeEnd;
  550.     procedure EditRangeStart;
  551.     procedure EmptyTable;
  552.     function FindKey(const KeyValues: array of const): Boolean;
  553.     procedure FindNearest(const KeyValues: array of const);
  554.     procedure GetIndexNames(List: TStrings);
  555.     procedure GotoCurrent(Table: TTable);
  556.     function GotoKey: Boolean;
  557.     procedure GotoNearest;
  558.     procedure LockTable(LockType: TLockType);
  559.     procedure OpenIndexFile(const IndexName: string);
  560.     procedure RenameTable(const NewTableName: string);
  561.     procedure SetKey;
  562.     procedure SetRange(const StartValues, EndValues: array of const);
  563.     procedure SetRangeEnd;
  564.     procedure SetRangeStart;
  565.     procedure UnlockTable(LockType: TLockType);
  566.     property Exists: Boolean;
  567.     property IndexFieldCount: Integer;
  568.     property IndexFields[Index: Integer]: TField;
  569.     property KeyExclusive: Boolean;
  570.     property KeyFieldCount: Integer;
  571.     property TableLevel: Integer;
  572.   published
  573.     property Constraints stored ConstraintsStored;
  574.     property Exclusive: Boolean default False;
  575.     property FieldDefs stored FieldDefsStored;
  576.     property IndexDefs: TIndexDefs;
  577.     property IndexFieldNames: string;
  578.     property IndexFiles: TStrings;
  579.     property IndexName: string;
  580.     property MasterFields: string;
  581.     property MasterSource: TDataSource;
  582.     property ReadOnly: Boolean default False;
  583.     property StoreDefs: Boolean default False;
  584.     property TableName: TFileName;
  585.     property TableType: TTableType default ttDefault;
  586.     property UpdateMode;
  587.     property UpdateObject;
  588.   end;
  589.  
  590. { TBatchMove }
  591.  
  592.   TBatchMove = class(TComponent)
  593.   protected
  594.     procedure Notification(AComponent: TComponent;
  595.       Operation: TOperation); override;
  596.   public
  597.     constructor Create(AOwner: TComponent); override;
  598.     destructor Destroy; override;
  599.     procedure Execute;
  600.   public
  601.     property ChangedCount: Longint;
  602.     property KeyViolCount: Longint;
  603.     property MovedCount: Longint;
  604.     property ProblemCount: Longint;
  605.   published
  606.     property AbortOnKeyViol: Boolean default True;
  607.     property AbortOnProblem: Boolean default True;
  608.     property CommitCount: Integer default 0;
  609.     property ChangedTableName: TFileName;
  610.     property Destination: TTable;
  611.     property KeyViolTableName: TFileName;
  612.     property Mappings: TStrings;
  613.     property Mode: TBatchMode default batAppend;
  614.     property ProblemTableName: TFileName;
  615.     property RecordCount: Longint default 0;
  616.     property Source: TBDEDataSet;
  617.     property Transliterate: Boolean default True;
  618.   end;
  619.  
  620. { TParam }
  621.  
  622.   TQuery = class;
  623.   TParams = class;
  624.  
  625.   TParamType = (ptUnknown, ptInput, ptOutput, ptInputOutput, ptResult);
  626.  
  627.   TParam = class(TPersistent)
  628.   protected
  629.     procedure AssignParam(Param: TParam);
  630.     procedure AssignTo(Dest: TPersistent); override;
  631.     function GetAsBCD: Currency;
  632.     function GetAsBoolean: Boolean;
  633.     function GetAsDateTime: TDateTime;
  634.     function GetAsFloat: Double;
  635.     function GetAsInteger: Longint;
  636.     function GetAsMemo: string;
  637.     function GetAsString: string;
  638.     function GetAsVariant: Variant;
  639.     function IsEqual(Value: TParam): Boolean;
  640.     function RecBufDataSize: Integer;
  641.     procedure RecBufGetData(Buffer: Pointer; Locale: TLocale);
  642.     procedure SetAsBCD(Value: Currency);
  643.     procedure SetAsBlob(Value: TBlobData);
  644.     procedure SetAsBoolean(Value: Boolean);
  645.     procedure SetAsCurrency(Value: Double);
  646.     procedure SetAsDate(Value: TDateTime);
  647.     procedure SetAsDateTime(Value: TDateTime);
  648.     procedure SetAsFloat(Value: Double);
  649.     procedure SetAsInteger(Value: Longint);
  650.     procedure SetAsMemo(const Value: string);
  651.     procedure SetAsString(const Value: string);
  652.     procedure SetAsSmallInt(Value: LongInt);
  653.     procedure SetAsTime(Value: TDateTime);
  654.     procedure SetAsVariant(Value: Variant);
  655.     procedure SetAsWord(Value: LongInt);
  656.     procedure SetDataType(Value: TFieldType);
  657.     procedure SetText(const Value: string);
  658.   public
  659.     constructor Create(AParamList: TParams; AParamType: TParamType);
  660.     destructor Destroy; override;
  661.     procedure Assign(Source: TPersistent); override;
  662.     procedure AssignField(Field: TField);
  663.     procedure AssignFieldValue(Field: TField; const Value: Variant);
  664.     procedure Clear;
  665.     procedure GetData(Buffer: Pointer);
  666.     function GetDataSize: Integer;
  667.     procedure LoadFromFile(const FileName: string; BlobType: TBlobType);
  668.     procedure LoadFromStream(Stream: TStream; BlobType: TBlobType);
  669.     procedure SetBlobData(Buffer: Pointer; Size: Integer);
  670.     procedure SetData(Buffer: Pointer);
  671.     property AsBCD: Currency;
  672.     property AsBlob: TBlobData;
  673.     property AsBoolean: Boolean;
  674.     property AsCurrency: Double;
  675.     property AsDate: TDateTime;
  676.     property AsDateTime: TDateTime;
  677.     property AsFloat: Double;
  678.     property AsInteger: LongInt;
  679.     property AsSmallInt: LongInt;
  680.     property AsMemo: string;
  681.     property AsString: string;
  682.     property AsTime: TDateTime;
  683.     property AsWord: LongInt;
  684.     property Bound: Boolean;
  685.     property DataType: TFieldType;
  686.     property IsNull: Boolean;
  687.     property Name: string;
  688.     property ParamType: TParamType;
  689.     property Text: string;
  690.     property Value: Variant;
  691.   end;
  692.  
  693. { TParams }
  694.  
  695.   TParams = class(TPersistent)
  696.   protected
  697.     procedure AssignTo(Dest: TPersistent); override;
  698.     procedure DefineProperties(Filer: TFiler); override;
  699.   public
  700.     constructor Create; virtual;
  701.     destructor Destroy; override;
  702.     procedure Assign(Source: TPersistent); override;
  703.     procedure AssignValues(Value: TParams);
  704.     procedure AddParam(Value: TParam);
  705.     procedure RemoveParam(Value: TParam);
  706.     function CreateParam(FldType: TFieldType; const ParamName: string;
  707.       ParamType: TParamType): TParam;
  708.     function Count: Integer;
  709.     procedure Clear;
  710.     procedure GetParamList(List: TList; const ParamNames: string);
  711.     function IsEqual(Value: TParams): Boolean;
  712.     function ParamByName(const Value: string): TParam;
  713.     property Items[Index: Word]: TParam; default;
  714.     property ParamValues[const ParamName: string]: Variant;
  715.   end;
  716.  
  717. { TStoredProc }
  718.  
  719.   PServerDesc = ^TServerDesc;
  720.   TServerDesc = record
  721.     ParamName: string[DBIMAXSPNAMELEN];
  722.     BindType: TFieldType;
  723.   end;
  724.  
  725.   TParamBindMode = (pbByName, pbByNumber);
  726.  
  727.   TStoredProc = class(TDBDataSet)
  728.   protected
  729.     function CreateHandle: HDBICur; override;
  730.     procedure Disconnect; override;
  731.     function GetParamsCount: Word;
  732.     function SetDBFlag(Flag: Integer; Value: Boolean): Boolean; override;
  733.     procedure SetOverLoad(Value: Word);
  734.     procedure SetProcName(const Value: string);
  735.     procedure SetPrepared(Value: Boolean);
  736.     procedure SetPrepare(Value: Boolean);
  737.   public
  738.     constructor Create(AOwner: TComponent); override;
  739.     destructor Destroy; override;
  740.     procedure CopyParams(Value: TParams);
  741.     function DescriptionsAvailable: Boolean;
  742.     procedure ExecProc;
  743.     function ParamByName(const Value: string): TParam;
  744.     procedure Prepare;
  745.     procedure GetResults;
  746.     procedure UnPrepare;
  747.     property ParamCount: Word;
  748.     property StmtHandle: HDBIStmt;
  749.     property Prepared: Boolean;
  750.   published
  751.     property StoredProcName: string;
  752.     property Overload: Word default 0;
  753.     property Params: TParams;
  754.     property ParamBindMode: TParamBindMode default pbByName;
  755.     property UpdateObject;
  756.   end;
  757.  
  758. { TQuery }
  759.  
  760.   TQuery = class(TDBDataSet)
  761.   protected
  762.     function CreateHandle: HDBICur; override;
  763.     procedure Disconnect; override;
  764.     function GetDataSource: TDataSource; override;
  765.     function GetParamsCount: Word;
  766.     function SetDBFlag(Flag: Integer; Value: Boolean): Boolean; override;
  767.     property DataLink: TDataLink;
  768.   public
  769.     constructor Create(AOwner: TComponent); override;
  770.     destructor Destroy; override;
  771.     procedure ExecSQL;
  772.     function ParamByName(const Value: string): TParam;
  773.     procedure Prepare;
  774.     procedure UnPrepare;
  775.     property Prepared: Boolean;
  776.     property ParamCount: Word;
  777.     property Local: Boolean;
  778.     property StmtHandle: HDBIStmt;
  779.     property Text: string;
  780.     property RowsAffected: Integer;
  781.     property SQLBinary: PChar;
  782.   published
  783.     property Constrained: Boolean default False;
  784.     property Constraints stored ConstraintsStored;
  785.     property DataSource: TDataSource;
  786.     property ParamCheck: Boolean default True;
  787.     property RequestLive: Boolean default False;
  788.     property SQL: TStrings;
  789.     { This property must be listed after the SQL property for Delphi 1.0 compatibility }
  790.     property Params: TParams;
  791.     property UniDirectional: Boolean default False;
  792.     property UpdateMode;
  793.     property UpdateObject;
  794. end;
  795.  
  796. { TUpdateSQL }
  797.  
  798.   TUpdateSQL = class(TDataSetUpdateObject)
  799.   protected
  800.     function GetDataSet: TBDEDataSet; override;
  801.     procedure SetDataSet(ADataSet: TBDEDataSet); override;
  802.     procedure SQLChanged(Sender: TObject);
  803.   public
  804.     constructor Create(AOwner: TComponent); override;
  805.     destructor Destroy; override;
  806.     procedure Apply(UpdateKind: TUpdateKind); override;
  807.     procedure ExecSQL(UpdateKind: TUpdateKind);
  808.     procedure SetParams(UpdateKind: TUpdateKind);
  809.     property DataSet;
  810.     property Query[UpdateKind: TUpdateKind]: TQuery;
  811.     property SQL[UpdateKind: TUpdateKind]: TStrings;
  812.   published
  813.     property ModifySQL: TStrings index 0;
  814.     property InsertSQL: TStrings index 1;
  815.     property DeleteSQL: TStrings index 2;
  816.   end;
  817.  
  818. { TBlobStream }
  819.  
  820.   TBlobStream = class(TStream)
  821.   public
  822.     constructor Create(Field: TBlobField; Mode: TBlobStreamMode);
  823.     destructor Destroy; override;
  824.     function Read(var Buffer; Count: Longint): Longint; override;
  825.     function Write(const Buffer; Count: Longint): Longint; override;
  826.     function Seek(Offset: Longint; Origin: Word): Longint; override;
  827.     procedure Truncate;
  828.   end;
  829.  
  830. function AnsiToNative(Locale: TLocale; const AnsiStr: string;
  831.   NativeStr: PChar; MaxLen: Integer): PChar;
  832. procedure NativeToAnsi(Locale: TLocale; NativeStr: PChar;
  833.   var AnsiStr: string);
  834. procedure AnsiToNativeBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  835. procedure NativeToAnsiBuf(Locale: TLocale; Source, Dest: PChar; Len: Integer);
  836.  
  837. function NativeCompareStr(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  838. function NativeCompareStrBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  839. function NativeCompareText(Locale: TLocale; const S1, S2: string; Len: Integer): Integer;
  840. function NativeCompareTextBuf(Locale: TLocale; const S1, S2: PChar; Len: Integer): Integer;
  841.  
  842. procedure DbiError(ErrorCode: DBIResult);
  843. procedure Check(Status: DBIResult);
  844. procedure RegisterBDEInitProc(const InitProc: TBDEInitProc);
  845.  
  846. const
  847.   { Backward compatibility for TConfigMode }
  848.   cmVirtual = [cfmVirtual];
  849.   cmPersistent = [cfmPersistent];
  850.   cmSession = [cfmSession];
  851.   cmAll = [cfmVirtual, cfmPersistent, cfmSession];
  852.  
  853. var
  854.   Session: TSession;
  855.   Sessions: TSessionList;
  856.   CreateProviderProc: function(DataSet: TDBDataSet): IProvider = nil;
  857.  
  858. implementation
  859.